home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / gui / eagui30.lha / EAGUI / Modula2 / txt / Example.mod < prev    next >
Encoding:
Text File  |  1994-12-01  |  12.7 KB  |  580 lines
  1. (* REVISION HEADER ×××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××× *
  2.    
  3.  | $VER: Example 3.00 (23.11.94) by Stefan Schulz [sts]
  4.  
  5.  | Desc: Example for using EAGUI via M2
  6.  
  7.  | Dist: This Module is © Copyright 1994 by Stefan Schulz
  8.  
  9.  | Rqrs: Amiga OS 2.0 or higher
  10.  |       EAGUI.library V3
  11.  |       EAGUI - Environment Adaptive Graphic User Interface
  12.  |       Copyright © 1993, 1994 by Marcel Offermans and Frank Groen
  13.  
  14.  | Lang: M2Amiga
  15.  | Trns: M2Amiga Modula 2 Software Development System
  16.  |       © Copyright by A+L AG, CH-2540 Grenchen
  17.  
  18.  | Hist: Version \date\
  19.  |
  20.  |       3.00   \23.11.94\
  21.  |              adapted to EAGUI.library V3
  22.  |
  23.  |       1.01   \03.05.94\
  24.  |              exended for recognizing Button-Presses
  25.  |
  26.  |       1.00   \01.05.94\
  27.  |              initial Version
  28.  
  29.  * ×××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××× *)
  30.  
  31. MODULE Example;
  32.  
  33. (*$ DEFINE    Small:= FALSE
  34.  
  35.     IF    Small
  36.     StackChk   := FALSE
  37.     RangeChk   := FALSE
  38.     OverflowChk:= FALSE
  39.     NilChk     := FALSE
  40.     EntryClear := FALSE
  41.     CaseChk    := FALSE
  42.     ReturnChk  := FALSE
  43.     LargeVars  := FALSE
  44.     ENDIF            *)
  45.  
  46. (* IMPORTS ********************************************************************** *)
  47.  
  48. IMPORT    tf    : TextField;
  49.  
  50. IMPORT    d    : EAGuiD,
  51.     l    : EAGuiL,
  52.     m    : EAGuiMacros;
  53.  
  54. IMPORT    A    : Arts,
  55.     ar    : Arguments,
  56.     cv    : Conversions,
  57.     dfl    : DiskFontL,
  58.     dl    : DosL,
  59.     ed    : ExecD,
  60.     el    : ExecL,
  61.     gtd    : GadToolsD,
  62.     gtl    : GadToolsL,
  63.     gd    : GraphicsD,
  64.     gl    : GraphicsL,
  65.     hp    : Heap,
  66.     id    : IntuitionD,
  67.     il    : IntuitionL,
  68.     R,
  69.     S    : SYSTEM,
  70.     ud    : UtilityD;
  71.  
  72. (* ****************************************************************************** *)
  73.  
  74. (* GLOBALS ====================================================================== *)
  75.  
  76. CONST    WindowTitle    = "EAGUI-Example";
  77.     HowNice        = "Ah, a size change! How nice.";
  78.     OkButton    = "Oh! You pressed the Ok-Button! Fine.";
  79.     CancelButton    = "Cancel? Why so negative? Tsk tsk.";
  80.     EnterStringHere    = "Enter a string here:";
  81.     ErrNoDrawInfo    = "Couldn't get the draw info.\n";
  82.     ErrNoFont    = "Couldn't open font.\n";
  83.     ErrNoGadList    = "Couldn't create the gadget list.\n";
  84.     ErrNoObjects    = "Couldn't init the objects.\n";
  85.     ErrNoScreenLock    = "Couldn't lock default public screen.\n";
  86.     ErrNoVisualInfo    = "Couldn't get the visual info.\n";
  87.     ErrNoWindow    = "Couldn't open the window.\n";
  88.     Ok        = "OK";
  89.     Cancel        = "Cancel";
  90.  
  91. CONST    DefaultFont    = "helvetica.font";
  92.  
  93. CONST    okID        = 1;
  94.     cancelID    = 2;
  95.  
  96. VAR    WinObj,
  97.     OkObj,
  98.     CancelObj,
  99.     HGroupObj    : d.OPTR;
  100.     
  101.     Win        : id.WindowPtr;
  102.     Scr        : id.ScreenPtr;
  103.     GadList        : id.GadgetPtr;
  104.     StringGadget    : id.GadgetPtr;
  105.     VisualInfo    : S.ADDRESS;
  106.     DrawInfo    : id.DrawInfoPtr;
  107.     TextFont    : gd.TextFontPtr;
  108.     
  109.     TextAttr    := gd.TextAttr {name  : S.ADR(DefaultFont),
  110.                     ySize : 15,
  111.                     style : gd.normalFont,
  112.                     flags : gd.FontFlagSet{gd.diskFont}
  113.                        };
  114.     RelHook,
  115.     TFMinSizeHook,
  116.     TFRenderHook    : ud.Hook;
  117.     IMsg        : id.IntuiMessage;
  118.     TextField1    : tf.ciTextField;
  119.  
  120. (* ============================================================================== *)
  121.  
  122. (* Same Size Relation ----------------------------------------------------------- *)
  123. PROCEDURE RelSameSize      (    hook{R.A0}  : ud.HookPtr;
  124.                 obj{R.A2}   : S.ADDRESS;
  125.                 msg{R.A1}   : S.ADDRESS        ) : S.ADDRESS;
  126.  
  127.  VAR    rObj        : d.RelationObjectPtr;
  128.     list        : ed.ListPtr;
  129.     ok,
  130.     minx, miny,
  131.     x, y        : LONGCARD;
  132.     buffer        : ARRAY [1..6] OF LONGINT;
  133.     tagList        : ud.TagItemPtr;
  134.  
  135.  (*$ SaveA4:= TRUE *)
  136.  
  137.  BEGIN
  138.  
  139.  S.SETREG( R.A4, hook^.data );
  140.  
  141.  minx:= 0;
  142.  miny:= 0;
  143.  
  144.  (* examine the list of objects that are affected by the relation *)
  145.  list:= S.CAST(ed.ListPtr, obj);
  146.  rObj:= S.CAST(d.RelationObjectPtr, list^.head);
  147.  
  148.  WHILE    (rObj^.node.succ # NIL)
  149.   DO    tagList:= S.TAG(buffer,
  150.             d.minWidth,  0,
  151.             d.minHeight, 0,
  152.           ud.tagEnd);
  153.     buffer[2]:= S.ADR(x);
  154.     buffer[4]:= S.ADR(y);
  155.     
  156.     ok:= l.GetAttrsA(rObj^.objectPtr, tagList);
  157.     
  158.     (* find the maximum values of the minimum sizes *)
  159.     IF (x > minx) THEN minx:= x  END;
  160.     IF (y > miny) THEN miny:= y  END;
  161.     
  162.     rObj:= S.CAST(d.RelationObjectPtr, rObj^.node.succ);
  163.   END; (* while *)
  164.  
  165.  (* set all objects to the newly found minimum sizes *)
  166.  rObj:= S.CAST(d.RelationObjectPtr, list^.head);
  167.  
  168.  WHILE    (rObj^.node.succ # NIL)
  169.   DO    ok:= l.SetAttrsA
  170.         ( rObj^.objectPtr,
  171.           S.TAG(buffer,
  172.             d.minWidth,  minx,
  173.             d.minHeight, miny,
  174.           ud.tagEnd)
  175.         );
  176.     
  177.     rObj:= S.CAST(d.RelationObjectPtr, rObj^.node.succ);
  178.   END; (* while *)
  179.  
  180.  RETURN NIL;
  181.   
  182.  END RelSameSize;
  183.  
  184.  
  185.  
  186. (* Recreate the gadget-list ----------------------------------------------------- *)
  187.  
  188. PROCEDURE ResizeWindow;
  189.  
  190.  VAR    ok,
  191.     bLeft, bRight,
  192.     bTop, bBottom    : LONGINT;
  193.     int        : INTEGER;
  194.     buffer        : ARRAY [1..10] OF LONGINT;
  195.  
  196.  BEGIN
  197.  
  198.  (* if necessary, remove the gadget list from the window, and clean it up      *)
  199.  IF    (GadList # NIL)
  200.   THEN    int:= il.RemoveGList(Win, GadList, -1);
  201.     l.FreeGadgetList(WinObj, GadList);
  202.     GadList:= NIL;
  203.   END; (* if *)
  204.  
  205.  ok:= l.GetAttrsA
  206.     ( WinObj,
  207.       S.TAG(buffer,
  208.         d.borderLeft,   S.ADR(bLeft),
  209.         d.borderRight,  S.ADR(bRight),
  210.         d.borderTop,    S.ADR(bTop),
  211.         d.borderBottom, S.ADR(bBottom),
  212.       ud.tagDone)
  213.     ); (* l.GetAttrsA *)
  214.  
  215.  ok:= l.SetAttrsA
  216.     ( WinObj,
  217.       S.TAG(buffer,
  218.         d.width, Win^.width - Win^.borderLeft - Win^.borderRight
  219.              - bLeft - bRight,
  220.         d.height, Win^.height - Win^.borderTop - Win^.borderBottom
  221.              - bTop - bBottom,
  222.         d.left,  Win^.borderLeft,
  223.         d.top,   Win^.borderTop,
  224.       ud.tagDone)
  225.     ); (* l.SetAttrsA *)
  226.  
  227.  l.LayoutObjects(WinObj);
  228.  
  229.  A.Assert(l.CreateGadgetList(WinObj, S.ADR(GadList), VisualInfo, DrawInfo)
  230.       = d.errorOK,
  231.       S.ADR(ErrNoGadList)
  232.          );
  233.  
  234.  gl.EraseRect(Win^.rPort, Win^.borderLeft, Win^.borderTop,
  235.           Win^.width - Win^.borderRight - 1,
  236.           Win^.height - Win^.borderBottom - 1
  237.          );
  238.  
  239.  il.RefreshWindowFrame(Win);
  240.  
  241.  int:= il.AddGList(Win, GadList, -1, -1, NIL);
  242.  il.RefreshGList(GadList, Win, NIL, -1);
  243.  gtl.GTRefreshWindow(Win, NIL);
  244.  
  245.  (* finally, we render the imagery, if there is any              *)
  246.  l.RenderObjects(WinObj, Win^.rPort);
  247.  
  248.  END ResizeWindow;
  249.  
  250.  
  251.  
  252. (* Init all --------------------------------------------------------------------- *)
  253.  
  254. PROCEDURE Init;
  255.  
  256.  VAR    ok,
  257.     width, height,
  258.     bLeft, bRight,
  259.     bTop, bBottom    : LONGINT;
  260.     buffer1,
  261.     buffer2        : ARRAY [1..50] OF LONGINT;
  262.     bool        : BOOLEAN;
  263.  
  264.  BEGIN
  265.  
  266.  (* open the font *)
  267.  TextFont:= dfl.OpenDiskFont(S.ADR(TextAttr));
  268.  A.Assert(TextFont # NIL, S.ADR(ErrNoFont));
  269.  
  270.  (* initialize the relation *)
  271.  RelHook.entry:= RelSameSize;
  272.  RelHook.data := S.REG(R.A4);
  273.  
  274.  (* initialize textfield hooks *)
  275.  TFMinSizeHook.entry:= tf.MethMinSizeTextField;
  276.  TFMinSizeHook.data := S.REG(R.A4);
  277.  
  278.  TFRenderHook.entry:= tf.MethRenderTextField;
  279.  TFRenderHook.data := S.REG(R.A4);
  280.  
  281.  (* now we can build the object tree *)
  282.  
  283.  OkObj:= m.GTButton
  284.         ( Ok,
  285.           S.TAG(buffer1,
  286.             d.gtTextAttr, S.ADR(TextAttr),
  287.             d.id, okID,
  288.           ud.tagEnd)
  289.         );
  290.  
  291.  CancelObj:= m.GTButton
  292.         ( Cancel,
  293.           S.TAG(buffer1,
  294.             d.gtTextAttr, S.ADR(TextAttr),
  295.             d.id, cancelID,
  296.           ud.tagEnd)
  297.         );
  298.  
  299.  HGroupObj:= m.HGroup
  300.         ( S.TAG(buffer1,
  301.             d.borderTop, 4,
  302.             d.child, OkObj,
  303.             d.child, m.EmptyBox(1, NIL),
  304.             d.child, CancelObj,
  305.           ud.tagEnd)
  306.         );
  307.  
  308.  WinObj:= m.VGroup
  309.         ( S.TAG(buffer1,
  310.             d.borderLeft,   4,
  311.             d.borderRight,  4,
  312.             d.borderTop,    4,
  313.             d.borderBottom, 4,
  314.             d.child, l.NewObjectA
  315.              (d.typeCustomImage,
  316.               S.TAG(buffer2,
  317.                 d.borderBottom,  4,
  318.                 d.minSizeMethod, S.ADR(TFMinSizeHook),
  319.                 d.renderMethod,  S.ADR(TFRenderHook),
  320.                 d.userData,      S.ADR(TextField1),
  321.               ud.tagDone)),
  322.             d.child, m.GTString
  323.              ("",
  324.               S.TAG(buffer2,
  325.                 d.gtTextAttr,      S.ADR(TextAttr),
  326.                 d.instanceAddress, S.ADR(StringGadget),
  327.                 d.minWidth,        20,
  328.               ud.tagDone)),
  329.             d.child, HGroupObj,
  330.           ud.tagEnd)
  331.         ); (* m.VGroup *)
  332.  
  333.  A.Assert(WinObj # NIL, S.ADR(ErrNoObjects));
  334.  
  335.  ok:= l.NewRelationA
  336.     ( HGroupObj, S.ADR(RelHook),
  337.       S.TAG(buffer1,
  338.         d.object, OkObj,
  339.         d.object, CancelObj,
  340.       ud.tagEnd)
  341.     );
  342.  
  343.  (* lock the screen *)
  344.  Scr:= il.LockPubScreen(NIL);
  345.  A.Assert(Scr # NIL, S.ADR(ErrNoScreenLock));
  346.  
  347.  (* get VisualInfo and DrawInfo *)
  348.  VisualInfo:= gtl.GetVisualInfoA(Scr, NIL);
  349.  A.Assert(VisualInfo # NIL, S.ADR(ErrNoVisualInfo));
  350.  DrawInfo:= il.GetScreenDrawInfo(Scr);
  351.  A.Assert(DrawInfo # NIL, S.ADR(ErrNoDrawInfo));
  352.  
  353.  (* fill in the textfield structure *)
  354.  TextField1.string  := S.ADR(EnterStringHere);        (* title *)
  355.  TextField1.textAttr:= S.ADR(TextAttr);            (* font  *)
  356.  TextField1.flags   := tf.CITFFlagSet{tf.citfAlignTop};    (* alignment flags *)
  357.  TextField1.frontPen:= 2;                (* frontpen color index *)
  358.  
  359.  (* obtain the minimum dimensions of every object in the tree *)
  360.  l.GetMinSizes(WinObj);
  361.  
  362.  (* get some attributes *)
  363.  ok:= l.GetAttrsA
  364.     ( WinObj,
  365.       S.TAG(buffer1,
  366.         d.minWidth,    S.ADR(width),
  367.         d.minHeight,    S.ADR(height),
  368.         d.borderLeft,    S.ADR(bLeft),
  369.         d.borderRight,    S.ADR(bRight),
  370.         d.borderTop,    S.ADR(bTop),
  371.         d.borderBottom,    S.ADR(bBottom),
  372.       ud.tagEnd)
  373.     );
  374.  
  375.  (* open the window *)
  376.  Win:= il.OpenWindowTagList
  377.         ( NIL,
  378.           S.TAG(buffer1,
  379.             id.waTitle,       S.ADR(WindowTitle),
  380.             id.waFlags,       id.WindowFlagSet{id.windowDrag,
  381.                                id.windowDepth,
  382.                                id.windowClose,
  383.                                id.windowSizing,
  384.                                id.sizeBBottom,
  385.                                id.windowActive},
  386.             id.waIDCMP,       id.IDCMPFlagSet{ id.closeWindow,
  387.                                id.gadgetUp,
  388.                                id.refreshWindow,
  389.                                id.newSize},
  390.             id.waInnerHeight, height + bTop + bBottom,
  391.           ud.tagEnd)
  392.         );
  393.  
  394.  (* set the window limits *)
  395.  bool:= il.WindowLimits
  396.         ( Win,
  397.           width + Win^.borderLeft + Win^.borderRight + bLeft + bRight,
  398.           height + Win^.borderTop + Win^.borderBottom + bTop + bBottom,
  399.           -1,
  400.           height + Win^.borderTop + Win^.borderBottom + bTop + bBottom
  401.         );
  402.  
  403.  (* create the gadgets and add them to the window *)
  404.  ResizeWindow;
  405.  
  406.  END Init;
  407.  
  408.  
  409.  
  410. (* Clean up --------------------------------------------------------------------- *)
  411. PROCEDURE CleanUp;
  412.  
  413.  VAR    int    : INTEGER;
  414.  
  415.  BEGIN
  416.  
  417.  IF    (GadList # NIL)
  418.   THEN    int:= il.RemoveGList(Win, GadList, -1);
  419.     l.FreeGadgetList(WinObj, GadList);
  420.     GadList:= NIL;
  421.   END; (* if *)
  422.  
  423.  IF    (Win # NIL)
  424.   THEN    il.CloseWindow(Win);
  425.     Win:= NIL;
  426.   END;
  427.  
  428.  IF    (DrawInfo # NIL)
  429.   THEN    il.FreeScreenDrawInfo(Scr, DrawInfo);
  430.     DrawInfo:= NIL;
  431.   END;
  432.  
  433.  IF    (VisualInfo # NIL)
  434.   THEN    gtl.FreeVisualInfo(VisualInfo);
  435.     VisualInfo:= NIL;
  436.   END;
  437.  
  438.  IF    (Scr # NIL)
  439.   THEN    il.UnlockPubScreen(NIL, Scr);
  440.     Scr:= NIL;
  441.   END;
  442.  
  443.  IF    (WinObj # NIL)
  444.   THEN    l.DisposeObject(WinObj);
  445.     WinObj:= NIL;
  446.   END;
  447.  
  448.  IF    (TextFont # NIL)
  449.   THEN    gl.CloseFont(TextFont);
  450.     TextFont:= NIL;
  451.   END;
  452.  
  453.  END CleanUp;
  454.  
  455.  
  456. (* Message Handling ------------------------------------------------------------- *)
  457.  
  458. PROCEDURE HandleMsgs () : LONGCARD;
  459.  
  460.  VAR    iMsg        : id.IntuiMessagePtr;
  461.     rc        : LONGCARD;
  462.     buffer        : ARRAY [1..4] OF LONGINT;
  463.     adr        : S.ADDRESS;
  464.     test        : ARRAY [1..10] OF LONGCARD;
  465.  
  466.  BEGIN
  467.  
  468.  rc:= 0;
  469.  
  470.  REPEAT    iMsg:= gtl.GTGetIMsg(Win^.userPort);
  471.     IF    (iMsg # NIL)
  472.      THEN    el.CopyMem(iMsg, S.ADR(IMsg), SIZE(IMsg));
  473.         gtl.GTReplyIMsg(iMsg);
  474.         
  475.         IF    (id.refreshWindow IN IMsg.class)
  476.          THEN    gtl.GTBeginRefresh(Win);
  477.             gtl.GTEndRefresh(Win, TRUE);
  478.          ELSIF    (id.closeWindow IN IMsg.class)
  479.           THEN    rc:= 10;
  480.          ELSIF    (id.newSize IN IMsg.class)
  481.           THEN    ResizeWindow;
  482.             (* Just for fun, we put a string in the string gadget after each
  483.              * resize. This demonstrates how to use the EA_InstanceAddress
  484.              * tag to obtain pointers to gadgets, which you can use to modify
  485.              * the gadgets directly.
  486.              *)
  487.             adr:= S.ADR(HowNice);
  488.             gtl.GTSetGadgetAttrsA
  489.                     ( StringGadget, Win, NIL,
  490.                       S.TAG(buffer,
  491.                         gtd.gtstString, adr,
  492.                       ud.tagDone)
  493.                     );
  494.          ELSIF    (id.gadgetUp IN IMsg.class)
  495.           THEN    CASE id.GadgetPtr(IMsg.iAddress)^.gadgetID OF
  496.              | okID :
  497.                 adr:= S.ADR(OkButton);
  498.                 gtl.GTSetGadgetAttrsA
  499.                         ( StringGadget, Win, NIL,
  500.                           S.TAG(buffer,
  501.                             gtd.gtstString, adr,
  502.                           ud.tagDone)
  503.                         );
  504.              | cancelID :
  505.                 adr:= S.ADR(CancelButton);
  506.                 gtl.GTSetGadgetAttrsA
  507.                         ( StringGadget, Win, NIL,
  508.                           S.TAG(buffer,
  509.                             gtd.gtstString, adr,
  510.                           ud.tagDone)
  511.                         );
  512.              ELSE (* ooops :*)
  513.              END; (* if *)
  514.          END; (* if *)
  515.      END; (* if *)
  516.  UNTIL (iMsg = NIL);
  517.  
  518.  RETURN rc;
  519.  
  520.  END HandleMsgs;
  521.  
  522.  
  523.  
  524. (* Get submitted arguments ------------------------------------------------------ *)
  525.  
  526. PROCEDURE GetArguments;
  527.  
  528.  VAR    strBuf        : ARRAY [0..127] OF CHAR;
  529.     argNum, len    : INTEGER;
  530.     signed, err    : BOOLEAN;
  531.     long        : LONGINT;
  532.  
  533.  BEGIN
  534.  
  535.  argNum:= ar.NumArgs();
  536.  IF    (argNum > 0)
  537.   THEN    ar.GetArg(1, strBuf, len);
  538.     hp.Allocate(TextAttr.name, len);
  539.     el.CopyMem(S.ADR(strBuf), TextAttr.name, len);
  540.     
  541.     IF    (argNum > 1)
  542.      THEN    ar.GetArg(2, strBuf, len);
  543.         cv.StrToVal(strBuf, long, signed, 10, err);
  544.         TextAttr.ySize:= INTEGER(long);
  545.      END; (* if *)
  546.   END; (* if *)
  547.  
  548.  END GetArguments;
  549.  
  550.  
  551.  
  552. (* MAIN ========================================================================= *)
  553.  
  554. VAR    idcmpMask,
  555.     signals        : S.LONGSET;
  556.     winSig        : SHORTCARD;
  557.     done        : BOOLEAN;
  558.  
  559. BEGIN
  560.  
  561. GetArguments;
  562. Init;
  563.  
  564. winSig:= Win^.userPort^.sigBit;
  565. idcmpMask:= S.LONGSET{winSig};
  566.  
  567. WHILE    NOT done
  568.  DO    signals:= el.Wait(idcmpMask);
  569.     IF    (winSig IN signals)
  570.      THEN    done:= HandleMsgs() # 0;
  571.      END; (* if *)
  572.  END; (* while *)
  573.  
  574.  
  575. CLOSE
  576.  
  577. CleanUp;
  578.  
  579. END Example.
  580.